perm filename FILL.OLD[1,LCS] blob sn#093922 filedate 1974-03-24 generic text, type T, neo UTF8
00100		IMPLICIT INTEGER(A-Z)
00200		COMMON D(2000),Q(100),R(100),E(100)
00300		DATA Q/5,20,10,2,5,10,7,6,10,91*0/
00400		1,R/8,10,0,8,6,3,5,6,92*0/
00500	
00600	15	TOT=9
00700		R(1)=10
00800		R(2)=12
00900		R(3)=0
00950		R(4)=0
01000		R(5)=10
01100		R(6)=8
01200		R(7)=5
01300		R(8)=7
01400		R(9)=8
01410		TYPE 151
01420	151	FORMAT(' TYPE COORDS.'/)
01430	152	FORMAT(60I)
01440		ACCEPT 152,(Q(K),K=1,60)
01450		ACCEPT 152,(R(K),K=1,60)
01500	CC	DO 150 K=1,100
01600	CC150	E(K)=0
01610		E(5)=-1
01620		E(9)=-1
01625		ACCEPT 152,(E(K),K=1,60)
01630		CALL LINES(Q(1),R(1),3)
01635		ACCEPT 152,TOT
01640		DO 40 K=2,TOT
01650		J=2
01660		IF(E(K-1))J=3
01670	40	CALL LINES(Q(K),R(K),J)
01700		N=1
01800	4	JJ=0
01900		H=-1000
01950		Z=0
02000		DO 1 K=2,TOT
02100		IF(E(K).NE.0)GO TO 1
02150		A=R(K)
02160		B=R(K-1)
02165		IF(B.GT.A)GO TO 21
02170		C=A*1000+B
02175		GO TO 20
02180	21	C=B*1000+A
02190	20	IF(C.LE.Z)GO TO 1
02195		Z=C
02200	C  FINDS HIGHEST LINE
02300		JJ=K
02400		H=R(JJ)
02500	1	CONTINUE
02600	
02700		IF(JJ.EQ.0)GO TO 10
02800		J=JJ
02900		JA=J-1
03000	CC	JB=J-1
03100	CC	IF(JA.GT.TOT)JA=1
03200	CC	IF(JB.EQ.0)JB=TOT
03300	CC	IF(R(JA).GT.R(JB))GO TO 19
03400	CC	JA=J
03500	CC	J=JB
03600	C  J = END OF HIGHEST LINE
03700	19	RT=Q(J)
03800		LF=Q(JA)
03900		DIS=RT-LF
04000		RJ=R(J)
04100		RJ1=R(JA)
04200	16	E(J)=-1
04300	C  LINE USED
04400	CC	HT=IABS(RJ-RJ1)
04450		HT=RJ-RJ1
04500		M=1
04600		IF(DIS)M=-1
04700		U=LF
04800		IF(RJ.Lt.RJ1)U=RT
04850		IF(RJ1.LT.RJ)RJ=RJ1
04860		DIS=IABS(DIS)
04900	
05000	17	DO 2 K=LF,RT,M
05100		D(N)=K
05200		Y=(HT*(K-U))/DIS+RJ
05300		D(N+1)=Y
05400		H=-1000
05500	
05600	18	DO 3 I=2,TOT
05610		IF(E(I))GO TO 3
05655	C  SKIP IF SAME LINE.
06100		QA=Q(I)
06200		QB=Q(I-1)
06300		IF((QA.GE.K.AND.QB.GE.K).OR.(QA.LE.K.AND.QB.LE.K))GOTO 3
06400	C  LINE WAS NOT UNDER POINT K
06410		RA=R(I)
06420		RB=R(I-1)
06500		HX=IABS(RA-RB)
06600		IF(RA.GT.RB)RA=RB
06700		DX=IABS(QA-QB)
06800		IF(QB.LT.QA)QA=QB
06900		B=(HX*(K-QA))/DX+RA
07210		IF(B.GT.Y)GO TO 3
07300		IF(B.LE.H)GO TO 3
07400		H=B
07500		IX=I
07600	C  FOUND HIGHEST NEW POINT
07700	3	CONTINUE
07710		IF(H.EQ.Y)GO TO 2
07800	CC	IF(HX)GO TO 30
07900	CC	E(IX+1)=1
08000	C  WIPES OUT THIS LINE SEG.
08100	CC	GO TO 31
08200	30	IF(K.NE.Q(IX).AND.K.NE.Q(IX+1))E(IX)=1
08250	C  TOUCHING END OF SEG. DOES NOT COUNT.
08300	
08310		IF(H.EQ.-1000)GO TO 2
08400	31	D(N+2)=H
08500		N=N+3
08600	2	CONTINUE
08700	
08750		IF(D(N).EQ.-1000)GO TO 4
08800		D(N)=-1000
08900	C  MARKS END OF ONE FILL SECTION
09000		N=N+1
09100		GO TO 4
09200	
09300	CC10	IF(D(N-1).EQ.-1000)N=N-1
09350	10	N=N-1
09400		D(N-1)=-9999
09500	C  MARKS FINAL END
09510		IO=5
09520	33	WRITE(IO,34)(D(K),K=1,N)
09530	34	FORMAT(9I6)
09600		N=1
09700	13	J=3
09800	C  FOR INVIS. VECT.
09900		DX=D(N)
10000	12	CALL LINES(DX,D(N+1),J)
10100		J=2
10200		CALL LINES(DX,D(N+2),J)
10300		N=N+3
10400		DX=D(N)
10500		IF(DX.LE.-1000)GO TO 11
10600		CALL LINES(DX,D(N+2),J)
10700		CALL LINES(DX,D(N+1),J)
10800		N=N+3
10900		DX=D(N)
11000		IF(DX.GT.-1000)GO TO 12
11100	
11200	11	IF(DX.EQ.-9999)GO TO 14
11300		N=N+1
11400		GO TO 13
11500	14	PAUSE
11600		GO TO 15
11700		END
11800	
11900